home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / regcomp.c < prev    next >
C/C++ Source or Header  |  1995-11-14  |  35KB  |  1,654 lines
  1. /*    regcomp.c
  2.  */
  3.  
  4. /*
  5.  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
  6.  */
  7.  
  8. /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  9.  * confused with the original package (see point 3 below).  Thanks, Henry!
  10.  */
  11.  
  12. /* Additional note: this code is very heavily munged from Henry's version
  13.  * in places.  In some spots I've traded clarity for efficiency, so don't
  14.  * blame Henry for some of the lack of readability.
  15.  */
  16.  
  17. /* The names of the functions have been changed from regcomp and
  18.  * regexec to  pregcomp and pregexec in order to avoid conflicts
  19.  * with the POSIX routines of the same names.
  20. */
  21.  
  22. /*SUPPRESS 112*/
  23. /*
  24.  * pregcomp and pregexec -- regsub and regerror are not used in perl
  25.  *
  26.  *    Copyright (c) 1986 by University of Toronto.
  27.  *    Written by Henry Spencer.  Not derived from licensed software.
  28.  *
  29.  *    Permission is granted to anyone to use this software for any
  30.  *    purpose on any computer system, and to redistribute it freely,
  31.  *    subject to the following restrictions:
  32.  *
  33.  *    1. The author is not responsible for the consequences of use of
  34.  *        this software, no matter how awful, even if they arise
  35.  *        from defects in it.
  36.  *
  37.  *    2. The origin of this software must not be misrepresented, either
  38.  *        by explicit claim or by omission.
  39.  *
  40.  *    3. Altered versions must be plainly marked as such, and must not
  41.  *        be misrepresented as being the original software.
  42.  *
  43.  *
  44.  ****    Alterations to Henry's code are...
  45.  ****
  46.  ****    Copyright (c) 1991-1994, Larry Wall
  47.  ****
  48.  ****    You may distribute under the terms of either the GNU General Public
  49.  ****    License or the Artistic License, as specified in the README file.
  50.  
  51.  *
  52.  * Beware that some of this code is subtly aware of the way operator
  53.  * precedence is structured in regular expressions.  Serious changes in
  54.  * regular-expression syntax might require a total rethink.
  55.  */
  56. #include "EXTERN.h"
  57. #include "perl.h"
  58. #include "INTERN.h"
  59. #include "regcomp.h"
  60.  
  61. #ifdef MSDOS
  62. # if defined(BUGGY_MSC6)
  63.  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
  64.  # pragma optimize("a",off)
  65.  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
  66.  # pragma optimize("w",on )
  67. # endif /* BUGGY_MSC6 */
  68. #endif /* MSDOS */
  69.  
  70. #ifndef STATIC
  71. #define    STATIC    static
  72. #endif
  73.  
  74. #define    ISMULT1(c)    ((c) == '*' || (c) == '+' || (c) == '?')
  75. #define    ISMULT2(s)    ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
  76.     ((*s) == '{' && regcurly(s)))
  77. #ifdef atarist
  78. #define    PERL_META    "^$.[()|?+*\\"
  79. #else
  80. #define    META    "^$.[()|?+*\\"
  81. #endif
  82.  
  83. #ifdef SPSTART
  84. #undef SPSTART        /* dratted cpp namespace... */
  85. #endif
  86. /*
  87.  * Flags to be passed up and down.
  88.  */
  89. #define    WORST        0    /* Worst case. */
  90. #define    HASWIDTH    0x1    /* Known never to match null string. */
  91. #define    SIMPLE        0x2    /* Simple enough to be STAR/PLUS operand. */
  92. #define    SPSTART        0x4    /* Starts with * or +. */
  93. #define TRYAGAIN    0x8    /* Weeded out a declaration. */
  94.  
  95. /*
  96.  * Forward declarations for pregcomp()'s friends.
  97.  */
  98.  
  99. static char *reg _((I32, I32 *));
  100. static char *reganode _((char, unsigned short));
  101. static char *regatom _((I32 *));
  102. static char *regbranch _((I32 *));
  103. static void regc _((char));
  104. static char *regclass _((void));
  105. STATIC I32 regcurly _((char *));
  106. static char *regnode _((char));
  107. static char *regpiece _((I32 *));
  108. static void reginsert _((char, char *));
  109. static void regoptail _((char *, char *));
  110. static void regset _((char *, I32, I32));
  111. static void regtail _((char *, char *));
  112. static char* nextchar _((void));
  113.  
  114. /*
  115.  - pregcomp - compile a regular expression into internal code
  116.  *
  117.  * We can't allocate space until we know how big the compiled form will be,
  118.  * but we can't compile it (and thus know how big it is) until we've got a
  119.  * place to put the code.  So we cheat:  we compile it twice, once with code
  120.  * generation turned off and size counting turned on, and once "for real".
  121.  * This also means that we don't allocate space until we are sure that the
  122.  * thing really will compile successfully, and we never have to move the
  123.  * code and thus invalidate pointers into it.  (Note that it has to be in
  124.  * one piece because free() must be able to free it all.) [NB: not true in perl]
  125.  *
  126.  * Beware that the optimization-preparation code in here knows about some
  127.  * of the structure of the compiled regexp.  [I'll say.]
  128.  */
  129. regexp *
  130. pregcomp(exp,xend,pm)
  131. char* exp;
  132. char* xend;
  133. PMOP* pm;
  134. {
  135.     I32 fold = pm->op_pmflags & PMf_FOLD;
  136.     register regexp *r;
  137.     register char *scan;
  138.     register SV *longish;
  139.     SV *longest;
  140.     register I32 len;
  141.     register char *first;
  142.     I32 flags;
  143.     I32 backish;
  144.     I32 backest;
  145.     I32 curback;
  146.     I32 minlen = 0;
  147.     I32 sawplus = 0;
  148.     I32 sawopen = 0;
  149.  
  150.     if (exp == NULL)
  151.     croak("NULL regexp argument");
  152.  
  153.     /* First pass: determine size, legality. */
  154.     regflags = pm->op_pmflags;
  155.     regparse = exp;
  156.     regxend = xend;
  157.     regprecomp = savepvn(exp,xend-exp);
  158.     regnaughty = 0;
  159.     regsawback = 0;
  160.     regnpar = 1;
  161.     regsize = 0L;
  162.     regcode = ®dummy;
  163.     regc((char)MAGIC);
  164.     if (reg(0, &flags) == NULL) {
  165.     Safefree(regprecomp);
  166.     regprecomp = Nullch;
  167.     return(NULL);
  168.     }
  169.  
  170.     /* Small enough for pointer-storage convention? */
  171.     if (regsize >= 32767L)        /* Probably could be 65535L. */
  172.     FAIL("regexp too big");
  173.  
  174.     /* Allocate space. */
  175.     Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
  176.     if (r == NULL)
  177.     FAIL("regexp out of space");
  178.  
  179.     /* Second pass: emit code. */
  180.     r->prelen = xend-exp;
  181.     r->precomp = regprecomp;
  182.     r->subbeg = r->subbase = NULL;
  183.     regnaughty = 0;
  184.     regparse = exp;
  185.     regnpar = 1;
  186.     regcode = r->program;
  187.     regc((char)MAGIC);
  188.     if (reg(0, &flags) == NULL)
  189.     return(NULL);
  190.  
  191.     /* Dig out information for optimizations. */
  192.     pm->op_pmflags = regflags;
  193.     fold = pm->op_pmflags & PMf_FOLD;
  194.     r->regstart = Nullsv;    /* Worst-case defaults. */
  195.     r->reganch = 0;
  196.     r->regmust = Nullsv;
  197.     r->regback = -1;
  198.     r->regstclass = Nullch;
  199.     r->naughty = regnaughty >= 10;    /* Probably an expensive pattern. */
  200.     scan = r->program+1;            /* First BRANCH. */
  201.     if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
  202.     scan = NEXTOPER(scan);
  203.  
  204.     first = scan;
  205.     while ((OP(first) == OPEN && (sawopen = 1)) ||
  206.         (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  207.         (OP(first) == PLUS) ||
  208.         (OP(first) == MINMOD) ||
  209.         (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
  210.         if (OP(first) == PLUS)
  211.             sawplus = 1;
  212.         else
  213.             first += regarglen[(U8)OP(first)];
  214.         first = NEXTOPER(first);
  215.     }
  216.  
  217.     /* Starting-point info. */
  218.       again:
  219.     if (OP(first) == EXACTLY) {
  220.         r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
  221.         if (SvCUR(r->regstart) > !(sawstudy|fold))
  222.         fbm_compile(r->regstart,fold);
  223.         else
  224.         sv_upgrade(r->regstart, SVt_PVBM);
  225.     }
  226.     else if (strchr(simple+2,OP(first)))
  227.         r->regstclass = first;
  228.     else if (OP(first) == BOUND || OP(first) == NBOUND)
  229.         r->regstclass = first;
  230.     else if (regkind[(U8)OP(first)] == BOL) {
  231.         r->reganch = ROPT_ANCH;
  232.         first = NEXTOPER(first);
  233.           goto again;
  234.     }
  235.     else if ((OP(first) == STAR &&
  236.         regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
  237.         !(r->reganch & ROPT_ANCH) )
  238.     {
  239.         /* turn .* into ^.* with an implied $*=1 */
  240.         r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
  241.         first = NEXTOPER(first);
  242.           goto again;
  243.     }
  244.     if (sawplus && (!sawopen || !regsawback))
  245.         r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
  246.  
  247.     DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
  248.        OP(first), OP(NEXTOPER(first)), first - scan));
  249.     /*
  250.     * If there's something expensive in the r.e., find the
  251.     * longest literal string that must appear and make it the
  252.     * regmust.  Resolve ties in favor of later strings, since
  253.     * the regstart check works with the beginning of the r.e.
  254.     * and avoiding duplication strengthens checking.  Not a
  255.     * strong reason, but sufficient in the absence of others.
  256.     * [Now we resolve ties in favor of the earlier string if
  257.     * it happens that curback has been invalidated, since the
  258.     * earlier string may buy us something the later one won't.]
  259.     */
  260.     longish = newSVpv("",0);
  261.     longest = newSVpv("",0);
  262.     len = 0;
  263.     minlen = 0;
  264.     curback = 0;
  265.     backish = 0;
  266.     backest = 0;
  267.     while (OP(scan) != END) {
  268.         if (OP(scan) == BRANCH) {
  269.         if (OP(regnext(scan)) == BRANCH) {
  270.             curback = -30000;
  271.             while (OP(scan) == BRANCH)
  272.             scan = regnext(scan);
  273.         }
  274.         else    /* single branch is ok */
  275.             scan = NEXTOPER(scan);
  276.         continue;
  277.         }
  278.         if (OP(scan) == UNLESSM) {
  279.         curback = -30000;
  280.         scan = regnext(scan);
  281.         continue;
  282.         }
  283.         if (OP(scan) == EXACTLY) {
  284.         char *t;
  285.  
  286.         first = scan;
  287.         while (OP(t = regnext(scan)) == CLOSE)
  288.             scan = t;
  289.         minlen += *OPERAND(first);
  290.         if (curback - backish == len) {
  291.             sv_catpvn(longish, OPERAND(first)+1,
  292.             *OPERAND(first));
  293.             len += *OPERAND(first);
  294.             curback += *OPERAND(first);
  295.             first = regnext(scan);
  296.         }
  297.         else if (*OPERAND(first) >= len + (curback >= 0)) {
  298.             len = *OPERAND(first);
  299.             sv_setpvn(longish, OPERAND(first)+1,len);
  300.             backish = curback;
  301.             curback += len;
  302.             first = regnext(scan);
  303.         }
  304.         else
  305.             curback += *OPERAND(first);
  306.         }
  307.         else if (strchr(varies,OP(scan))) {
  308.         curback = -30000;
  309.         len = 0;
  310.         if (SvCUR(longish) > SvCUR(longest)) {
  311.             sv_setsv(longest,longish);
  312.             backest = backish;
  313.         }
  314.         sv_setpvn(longish,"",0);
  315.         if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
  316.             minlen++;
  317.         else if (regkind[(U8)OP(scan)] == CURLY &&
  318.           strchr(simple,OP(NEXTOPER(scan)+4)))
  319.             minlen += ARG1(scan);
  320.         }
  321.         else if (strchr(simple,OP(scan))) {
  322.         curback++;
  323.         minlen++;
  324.         len = 0;
  325.         if (SvCUR(longish) > SvCUR(longest)) {
  326.             sv_setsv(longest,longish);
  327.             backest = backish;
  328.         }
  329.         sv_setpvn(longish,"",0);
  330.         }
  331.         scan = regnext(scan);
  332.     }
  333.  
  334.     /* Prefer earlier on tie, unless we can tail match latter */
  335.  
  336.     if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL) >
  337.         SvCUR(longest))
  338.     {
  339.         sv_setsv(longest,longish);
  340.         backest = backish;
  341.     }
  342.     else
  343.         sv_setpvn(longish,"",0);
  344.     if (SvCUR(longest)
  345.         &&
  346.         (!r->regstart
  347.          ||
  348.          !fbm_instr((unsigned char*) SvPVX(r->regstart),
  349.           (unsigned char *) SvPVX(r->regstart)
  350.             + SvCUR(r->regstart),
  351.           longest)
  352.         )
  353.        )
  354.     {
  355.         r->regmust = longest;
  356.         if (backest < 0)
  357.         backest = -1;
  358.         r->regback = backest;
  359.         if (SvCUR(longest) > !(sawstudy || fold ||
  360.             regkind[(U8)OP(first)]==EOL))
  361.         fbm_compile(r->regmust,fold);
  362.         (void)SvUPGRADE(r->regmust, SVt_PVBM);
  363.         BmUSEFUL(r->regmust) = 100;
  364.         if (regkind[(U8)OP(first)] == EOL && SvCUR(longish))
  365.         SvTAIL_on(r->regmust);
  366.     }
  367.     else {
  368.         SvREFCNT_dec(longest);
  369.         longest = Nullsv;
  370.     }
  371.     SvREFCNT_dec(longish);
  372.     }
  373.  
  374.     r->do_folding = fold;
  375.     r->nparens = regnpar - 1;
  376.     r->minlen = minlen;
  377.     Newz(1002, r->startp, regnpar, char*);
  378.     Newz(1002, r->endp, regnpar, char*);
  379.     DEBUG_r(regdump(r));
  380.     return(r);
  381. }
  382.  
  383. /*
  384.  - reg - regular expression, i.e. main body or parenthesized thing
  385.  *
  386.  * Caller must absorb opening parenthesis.
  387.  *
  388.  * Combining parenthesis handling with the base level of regular expression
  389.  * is a trifle forced, but the need to tie the tails of the branches to what
  390.  * follows makes it hard to avoid.
  391.  */
  392. static char *
  393. reg(paren, flagp)
  394. I32 paren;            /* Parenthesized? */
  395. I32 *flagp;
  396. {
  397.     register char *ret;
  398.     register char *br;
  399.     register char *ender = 0;
  400.     register I32 parno = 0;
  401.     I32 flags;
  402.  
  403.     *flagp = HASWIDTH;    /* Tentatively. */
  404.  
  405.     /* Make an OPEN node, if parenthesized. */
  406.     if (paren) {
  407.     if (*regparse == '?') {
  408.         regparse++;
  409.         paren = *regparse++;
  410.         ret = NULL;
  411.         switch (paren) {
  412.         case ':':
  413.         case '=':
  414.         case '!':
  415.         break;
  416.         case '$':
  417.         case '@':
  418.         croak("Sequence (?%c...) not implemented", paren);
  419.         break;
  420.         case '#':
  421.         while (*regparse && *regparse != ')')
  422.             regparse++;
  423.         if (*regparse != ')')
  424.             croak("Sequence (?#... not terminated");
  425.         nextchar();
  426.         *flagp = TRYAGAIN;
  427.         return NULL;
  428.         default:
  429.         --regparse;
  430.         while (*regparse && strchr("iogmsx", *regparse))
  431.             pmflag(®flags, *regparse++);
  432.         if (*regparse != ')')
  433.             croak("Sequence (?%c...) not recognized", *regparse);
  434.         nextchar();
  435.         *flagp = TRYAGAIN;
  436.         return NULL;
  437.         }
  438.     }
  439.     else {
  440.         parno = regnpar;
  441.         regnpar++;
  442.         ret = reganode(OPEN, parno);
  443.     }
  444.     } else
  445.     ret = NULL;
  446.  
  447.     /* Pick up the branches, linking them together. */
  448.     br = regbranch(&flags);
  449.     if (br == NULL)
  450.     return(NULL);
  451.     if (ret != NULL)
  452.     regtail(ret, br);    /* OPEN -> first. */
  453.     else
  454.     ret = br;
  455.     if (!(flags&HASWIDTH))
  456.     *flagp &= ~HASWIDTH;
  457.     *flagp |= flags&SPSTART;
  458.     while (*regparse == '|') {
  459.     nextchar();
  460.     br = regbranch(&flags);
  461.     if (br == NULL)
  462.         return(NULL);
  463.     regtail(ret, br);    /* BRANCH -> BRANCH. */
  464.     if (!(flags&HASWIDTH))
  465.         *flagp &= ~HASWIDTH;
  466.     *flagp |= flags&SPSTART;
  467.     }
  468.  
  469.     /* Make a closing node, and hook it on the end. */
  470.     switch (paren) {
  471.     case ':':
  472.     ender = regnode(NOTHING);
  473.     break;
  474.     case 1:
  475.     ender = reganode(CLOSE, parno);
  476.     break;
  477.     case '=':
  478.     case '!':
  479.     ender = regnode(SUCCEED);
  480.     *flagp &= ~HASWIDTH;
  481.     break;
  482.     case 0:
  483.     ender = regnode(END);
  484.     break;
  485.     }
  486.     regtail(ret, ender);
  487.  
  488.     /* Hook the tails of the branches to the closing node. */
  489.     for (br = ret; br != NULL; br = regnext(br))
  490.     regoptail(br, ender);
  491.  
  492.     if (paren == '=') {
  493.     reginsert(IFMATCH,ret);
  494.     regtail(ret, regnode(NOTHING));
  495.     }
  496.     else if (paren == '!') {
  497.     reginsert(UNLESSM,ret);
  498.     regtail(ret, regnode(NOTHING));
  499.     }
  500.  
  501.     /* Check for proper termination. */
  502.     if (paren && (regparse >= regxend || *nextchar() != ')')) {
  503.     FAIL("unmatched () in regexp");
  504.     } else if (!paren && regparse < regxend) {
  505.     if (*regparse == ')') {
  506.         FAIL("unmatched () in regexp");
  507.     } else
  508.         FAIL("junk on end of regexp");    /* "Can't happen". */
  509.     /* NOTREACHED */
  510.     }
  511.  
  512.     return(ret);
  513. }
  514.  
  515. /*
  516.  - regbranch - one alternative of an | operator
  517.  *
  518.  * Implements the concatenation operator.
  519.  */
  520. static char *
  521. regbranch(flagp)
  522. I32 *flagp;
  523. {
  524.     register char *ret;
  525.     register char *chain;
  526.     register char *latest;
  527.     I32 flags = 0;
  528.  
  529.     *flagp = WORST;        /* Tentatively. */
  530.  
  531.     ret = regnode(BRANCH);
  532.     chain = NULL;
  533.     regparse--;
  534.     nextchar();
  535.     while (regparse < regxend && *regparse != '|' && *regparse != ')') {
  536.     flags &= ~TRYAGAIN;
  537.     latest = regpiece(&flags);
  538.     if (latest == NULL) {
  539.         if (flags & TRYAGAIN)
  540.         continue;
  541.         return(NULL);
  542.     }
  543.     *flagp |= flags&HASWIDTH;
  544.     if (chain == NULL)    /* First piece. */
  545.         *flagp |= flags&SPSTART;
  546.     else {
  547.         regnaughty++;
  548.         regtail(chain, latest);
  549.     }
  550.     chain = latest;
  551.     }
  552.     if (chain == NULL)    /* Loop ran zero times. */
  553.     (void) regnode(NOTHING);
  554.  
  555.     return(ret);
  556. }
  557.  
  558. /*
  559.  - regpiece - something followed by possible [*+?]
  560.  *
  561.  * Note that the branching code sequences used for ? and the general cases
  562.  * of * and + are somewhat optimized:  they use the same NOTHING node as
  563.  * both the endmarker for their branch list and the body of the last branch.
  564.  * It might seem that this node could be dispensed with entirely, but the
  565.  * endmarker role is not redundant.
  566.  */
  567. static char *
  568. regpiece(flagp)
  569. I32 *flagp;
  570. {
  571.     register char *ret;
  572.     register char op;
  573.     register char *next;
  574.     I32 flags;
  575.     char *origparse = regparse;
  576.     char *maxpos;
  577.     I32 min;
  578.     I32 max = 32767;
  579.  
  580.     ret = regatom(&flags);
  581.     if (ret == NULL) {
  582.     if (flags & TRYAGAIN)
  583.         *flagp |= TRYAGAIN;
  584.     return(NULL);
  585.     }
  586.  
  587.     op = *regparse;
  588.     if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
  589.     while (op && op != ')')
  590.         op = *++regparse;
  591.     if (op) {
  592.         nextchar();
  593.         op = *regparse;
  594.     }
  595.     }
  596.  
  597.     if (op == '{' && regcurly(regparse)) {
  598.     next = regparse + 1;
  599.     maxpos = Nullch;
  600.     while (isDIGIT(*next) || *next == ',') {
  601.         if (*next == ',') {
  602.         if (maxpos)
  603.             break;
  604.         else
  605.             maxpos = next;
  606.         }
  607.         next++;
  608.     }
  609.     if (*next == '}') {        /* got one */
  610.         if (!maxpos)
  611.         maxpos = next;
  612.         regparse++;
  613.         min = atoi(regparse);
  614.         if (*maxpos == ',')
  615.         maxpos++;
  616.         else
  617.         maxpos = regparse;
  618.         max = atoi(maxpos);
  619.         if (!max && *maxpos != '0')
  620.         max = 32767;        /* meaning "infinity" */
  621.         regparse = next;
  622.         nextchar();
  623.  
  624.     do_curly:
  625.         if ((flags&SIMPLE)) {
  626.         regnaughty += 2 + regnaughty / 2;
  627.         reginsert(CURLY, ret);
  628.         }
  629.         else {
  630.         regnaughty += 4 + regnaughty;    /* compound interest */
  631.         regtail(ret, regnode(WHILEM));
  632.         reginsert(CURLYX,ret);
  633.         regtail(ret, regnode(NOTHING));
  634.         }
  635.  
  636.         if (min > 0)
  637.         *flagp = (WORST|HASWIDTH);
  638.         if (max && max < min)
  639.         croak("Can't do {n,m} with n > m");
  640.         if (regcode != ®dummy) {
  641. #ifdef REGALIGN
  642.         *(unsigned short *)(ret+3) = min;
  643.         *(unsigned short *)(ret+5) = max;
  644. #else
  645.         ret[3] = min >> 8; ret[4] = min & 0377;
  646.         ret[5] = max  >> 8; ret[6] = max  & 0377;
  647. #endif
  648.         }
  649.  
  650.         goto nest_check;
  651.     }
  652.     }
  653.  
  654.     if (!ISMULT1(op)) {
  655.     *flagp = flags;
  656.     return(ret);
  657.     }
  658.     nextchar();
  659.  
  660.     *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
  661.  
  662.     if (op == '*' && (flags&SIMPLE)) {
  663.     reginsert(STAR, ret);
  664.     regnaughty += 4;
  665.     }
  666.     else if (op == '*') {
  667.     min = 0;
  668.     goto do_curly;
  669.     } else if (op == '+' && (flags&SIMPLE)) {
  670.     reginsert(PLUS, ret);
  671.     regnaughty += 3;
  672.     }
  673.     else if (op == '+') {
  674.     min = 1;
  675.     goto do_curly;
  676.     } else if (op == '?') {
  677.     min = 0; max = 1;
  678.     goto do_curly;
  679.     }
  680.   nest_check:
  681.     if (dowarn && regcode != ®dummy && !(flags&HASWIDTH) && max > 10000) {
  682.     warn("%.*s matches null string many times",
  683.         regparse - origparse, origparse);
  684.     }
  685.  
  686.     if (*regparse == '?') {
  687.     nextchar();
  688.     reginsert(MINMOD, ret);
  689. #ifdef REGALIGN
  690.     regtail(ret, ret + 4);
  691. #else
  692.     regtail(ret, ret + 3);
  693. #endif
  694.     }
  695.     if (ISMULT2(regparse))
  696.     FAIL("nested *?+ in regexp");
  697.  
  698.     return(ret);
  699. }
  700.  
  701. /*
  702.  - regatom - the lowest level
  703.  *
  704.  * Optimization:  gobbles an entire sequence of ordinary characters so that
  705.  * it can turn them into a single node, which is smaller to store and
  706.  * faster to run.  Backslashed characters are exceptions, each becoming a
  707.  * separate node; the code is simpler that way and it's not worth fixing.
  708.  *
  709.  * [Yes, it is worth fixing, some scripts can run twice the speed.]
  710.  */
  711. static char *
  712. regatom(flagp)
  713. I32 *flagp;
  714. {
  715.     register char *ret = 0;
  716.     I32 flags;
  717.  
  718.     *flagp = WORST;        /* Tentatively. */
  719.  
  720. tryagain:
  721.     switch (*regparse) {
  722.     case '^':
  723.     nextchar();
  724.     if (regflags & PMf_MULTILINE)
  725.         ret = regnode(MBOL);
  726.     else if (regflags & PMf_SINGLELINE)
  727.         ret = regnode(SBOL);
  728.     else
  729.         ret = regnode(BOL);
  730.     break;
  731.     case '$':
  732.     nextchar();
  733.     if (regflags & PMf_MULTILINE)
  734.         ret = regnode(MEOL);
  735.     else if (regflags & PMf_SINGLELINE)
  736.         ret = regnode(SEOL);
  737.     else
  738.         ret = regnode(EOL);
  739.     break;
  740.     case '.':
  741.     nextchar();
  742.     if (regflags & PMf_SINGLELINE)
  743.         ret = regnode(SANY);
  744.     else
  745.         ret = regnode(ANY);
  746.     regnaughty++;
  747.     *flagp |= HASWIDTH|SIMPLE;
  748.     break;
  749.     case '[':
  750.     regparse++;
  751.     ret = regclass();
  752.     *flagp |= HASWIDTH|SIMPLE;
  753.     break;
  754.     case '(':
  755.     nextchar();
  756.     ret = reg(1, &flags);
  757.     if (ret == NULL) {
  758.         if (flags & TRYAGAIN)
  759.             goto tryagain;
  760.         return(NULL);
  761.     }
  762.     *flagp |= flags&(HASWIDTH|SPSTART);
  763.     break;
  764.     case '|':
  765.     case ')':
  766.     if (flags & TRYAGAIN) {
  767.         *flagp |= TRYAGAIN;
  768.         return NULL;
  769.     }
  770.     croak("internal urp in regexp at /%s/", regparse);
  771.                 /* Supposed to be caught earlier. */
  772.     break;
  773.     case '?':
  774.     case '+':
  775.     case '*':
  776.     FAIL("?+* follows nothing in regexp");
  777.     break;
  778.     case '\\':
  779.     switch (*++regparse) {
  780.     case 'A':
  781.         ret = regnode(SBOL);
  782.         *flagp |= SIMPLE;
  783.         nextchar();
  784.         break;
  785.     case 'G':
  786.         ret = regnode(GBOL);
  787.         *flagp |= SIMPLE;
  788.         nextchar();
  789.         break;
  790.     case 'Z':
  791.         ret = regnode(SEOL);
  792.         *flagp |= SIMPLE;
  793.         nextchar();
  794.         break;
  795.     case 'w':
  796.         ret = regnode(ALNUM);
  797.         *flagp |= HASWIDTH|SIMPLE;
  798.         nextchar();
  799.         break;
  800.     case 'W':
  801.         ret = regnode(NALNUM);
  802.         *flagp |= HASWIDTH|SIMPLE;
  803.         nextchar();
  804.         break;
  805.     case 'b':
  806.         ret = regnode(BOUND);
  807.         *flagp |= SIMPLE;
  808.         nextchar();
  809.         break;
  810.     case 'B':
  811.         ret = regnode(NBOUND);
  812.         *flagp |= SIMPLE;
  813.         nextchar();
  814.         break;
  815.     case 's':
  816.         ret = regnode(SPACE);
  817.         *flagp |= HASWIDTH|SIMPLE;
  818.         nextchar();
  819.         break;
  820.     case 'S':
  821.         ret = regnode(NSPACE);
  822.         *flagp |= HASWIDTH|SIMPLE;
  823.         nextchar();
  824.         break;
  825.     case 'd':
  826.         ret = regnode(DIGIT);
  827.         *flagp |= HASWIDTH|SIMPLE;
  828.         nextchar();
  829.         break;
  830.     case 'D':
  831.         ret = regnode(NDIGIT);
  832.         *flagp |= HASWIDTH|SIMPLE;
  833.         nextchar();
  834.         break;
  835.     case 'n':
  836.     case 'r':
  837.     case 't':
  838.     case 'f':
  839.     case 'e':
  840.     case 'a':
  841.     case 'x':
  842.     case 'c':
  843.     case '0':
  844.         goto defchar;
  845.     case '1': case '2': case '3': case '4':
  846.     case '5': case '6': case '7': case '8': case '9':
  847.         {
  848.         I32 num = atoi(regparse);
  849.  
  850.         if (num > 9 && num >= regnpar)
  851.             goto defchar;
  852.         else {
  853.             regsawback = 1;
  854.             ret = reganode(REF, num);
  855.             *flagp |= HASWIDTH;
  856.             while (isDIGIT(*regparse))
  857.             regparse++;
  858.             regparse--;
  859.             nextchar();
  860.         }
  861.         }
  862.         break;
  863.     case '\0':
  864.         if (regparse >= regxend)
  865.         FAIL("trailing \\ in regexp");
  866.         /* FALL THROUGH */
  867.     default:
  868.         goto defchar;
  869.     }
  870.     break;
  871.  
  872.     case '#':
  873.     if (regflags & PMf_EXTENDED) {
  874.         while (regparse < regxend && *regparse != '\n') regparse++;
  875.         if (regparse < regxend)
  876.         goto tryagain;
  877.     }
  878.     /* FALL THROUGH */
  879.  
  880.     default: {
  881.         register I32 len;
  882.         register char ender;
  883.         register char *p;
  884.         char *oldp;
  885.         I32 numlen;
  886.  
  887.         regparse++;
  888.  
  889.     defchar:
  890.         ret = regnode(EXACTLY);
  891.         regc(0);        /* save spot for len */
  892.         for (len = 0, p = regparse - 1;
  893.           len < 127 && p < regxend;
  894.           len++)
  895.         {
  896.         oldp = p;
  897.         switch (*p) {
  898.         case '^':
  899.         case '$':
  900.         case '.':
  901.         case '[':
  902.         case '(':
  903.         case ')':
  904.         case '|':
  905.             goto loopdone;
  906.         case '\\':
  907.             switch (*++p) {
  908.             case 'A':
  909.             case 'G':
  910.             case 'Z':
  911.             case 'w':
  912.             case 'W':
  913.             case 'b':
  914.             case 'B':
  915.             case 's':
  916.             case 'S':
  917.             case 'd':
  918.             case 'D':
  919.             --p;
  920.             goto loopdone;
  921.             case 'n':
  922.             ender = '\n';
  923.             p++;
  924.             break;
  925.             case 'r':
  926.             ender = '\r';
  927.             p++;
  928.             break;
  929.             case 't':
  930.             ender = '\t';
  931.             p++;
  932.             break;
  933.             case 'f':
  934.             ender = '\f';
  935.             p++;
  936.             break;
  937.             case 'e':
  938.             ender = '\033';
  939.             p++;
  940.             break;
  941.             case 'a':
  942.             ender = '\007';
  943.             p++;
  944.             break;
  945.             case 'x':
  946.             ender = scan_hex(++p, 2, &numlen);
  947.             p += numlen;
  948.             break;
  949.             case 'c':
  950.             p++;
  951.             ender = *p++;
  952.             if (isLOWER(ender))
  953.                 ender = toUPPER(ender);
  954.             ender ^= 64;
  955.             break;
  956.             case '0': case '1': case '2': case '3':case '4':
  957.             case '5': case '6': case '7': case '8':case '9':
  958.             if (*p == '0' ||
  959.               (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
  960.                 ender = scan_oct(p, 3, &numlen);
  961.                 p += numlen;
  962.             }
  963.             else {
  964.                 --p;
  965.                 goto loopdone;
  966.             }
  967.             break;
  968.             case '\0':
  969.             if (p >= regxend)
  970.                 FAIL("trailing \\ in regexp");
  971.             /* FALL THROUGH */
  972.             default:
  973.             ender = *p++;
  974.             break;
  975.             }
  976.             break;
  977.         case '#':
  978.             if (regflags & PMf_EXTENDED) {
  979.             while (p < regxend && *p != '\n') p++;
  980.             }
  981.             /* FALL THROUGH */
  982.         case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
  983.             if (regflags & PMf_EXTENDED) {
  984.             p++;
  985.             len--;
  986.             continue;
  987.             }
  988.             /* FALL THROUGH */
  989.         default:
  990.             ender = *p++;
  991.             break;
  992.         }
  993.         if (regflags & PMf_FOLD && isUPPER(ender))
  994.             ender = toLOWER(ender);
  995.         if (ISMULT2(p)) { /* Back off on ?+*. */
  996.             if (len)
  997.             p = oldp;
  998.             else {
  999.             len++;
  1000.             regc(ender);
  1001.             }
  1002.             break;
  1003.         }
  1004.         regc(ender);
  1005.         }
  1006.     loopdone:
  1007.         regparse = p - 1;
  1008.         nextchar();
  1009.         if (len < 0)
  1010.         FAIL("internal disaster in regexp");
  1011.         if (len > 0)
  1012.         *flagp |= HASWIDTH;
  1013.         if (len == 1)
  1014.         *flagp |= SIMPLE;
  1015.         if (regcode != ®dummy)
  1016.         *OPERAND(ret) = len;
  1017.         regc('\0');
  1018.     }
  1019.     break;
  1020.     }
  1021.  
  1022.     return(ret);
  1023. }
  1024.  
  1025. static void
  1026. regset(bits,def,c)
  1027. char *bits;
  1028. I32 def;
  1029. register I32 c;
  1030. {
  1031.     if (regcode == ®dummy)
  1032.       return;
  1033.     c &= 255;
  1034.     if (def)
  1035.     bits[c >> 3] &= ~(1 << (c & 7));
  1036.     else
  1037.     bits[c >> 3] |=  (1 << (c & 7));
  1038. }
  1039.  
  1040. static char *
  1041. regclass()
  1042. {
  1043.     register char *bits;
  1044.     register I32 class;
  1045.     register I32 lastclass = 1234;
  1046.     register I32 range = 0;
  1047.     register char *ret;
  1048.     register I32 def;
  1049.     I32 numlen;
  1050.  
  1051.     ret = regnode(ANYOF);
  1052.     if (*regparse == '^') {    /* Complement of range. */
  1053.     regnaughty++;
  1054.     regparse++;
  1055.     def = 0;
  1056.     } else {
  1057.     def = 255;
  1058.     }
  1059.     bits = regcode;
  1060.     for (class = 0; class < 32; class++)
  1061.       regc(def);
  1062.     if (*regparse == ']' || *regparse == '-')
  1063.     goto skipcond;        /* allow 1st char to be ] or - */
  1064.     while (regparse < regxend && *regparse != ']') {
  1065.        skipcond:
  1066.     class = UCHARAT(regparse++);
  1067.     if (class == '\\') {
  1068.         class = UCHARAT(regparse++);
  1069.         switch (class) {
  1070.         case 'w':
  1071.         for (class = 0; class < 256; class++)
  1072.           if (isALNUM(class))
  1073.             regset(bits,def,class);
  1074.         lastclass = 1234;
  1075.         continue;
  1076.         case 'W':
  1077.         for (class = 0; class < 256; class++)
  1078.           if (!isALNUM(class))
  1079.             regset(bits,def,class);
  1080.         lastclass = 1234;
  1081.         continue;
  1082.         case 's':
  1083.         for (class = 0; class < 256; class++)
  1084.           if (isSPACE(class))
  1085.             regset(bits,def,class);
  1086.         lastclass = 1234;
  1087.         continue;
  1088.         case 'S':
  1089.         for (class = 0; class < 256; class++)
  1090.           if (!isSPACE(class))
  1091.             regset(bits,def,class);
  1092.         lastclass = 1234;
  1093.         continue;
  1094.         case 'd':
  1095.         for (class = '0'; class <= '9'; class++)
  1096.             regset(bits,def,class);
  1097.         lastclass = 1234;
  1098.         continue;
  1099.         case 'D':
  1100.         for (class = 0; class < '0'; class++)
  1101.             regset(bits,def,class);
  1102.         for (class = '9' + 1; class < 256; class++)
  1103.             regset(bits,def,class);
  1104.         lastclass = 1234;
  1105.         continue;
  1106.         case 'n':
  1107.         class = '\n';
  1108.         break;
  1109.         case 'r':
  1110.         class = '\r';
  1111.         break;
  1112.         case 't':
  1113.         class = '\t';
  1114.         break;
  1115.         case 'f':
  1116.         class = '\f';
  1117.         break;
  1118.         case 'b':
  1119.         class = '\b';
  1120.         break;
  1121.         case 'e':
  1122.         class = '\033';
  1123.         break;
  1124.         case 'a':
  1125.         class = '\007';
  1126.         break;
  1127.         case 'x':
  1128.         class = scan_hex(regparse, 2, &numlen);
  1129.         regparse += numlen;
  1130.         break;
  1131.         case 'c':
  1132.         class = *regparse++;
  1133.         if (isLOWER(class))
  1134.           class = toUPPER(class);
  1135.         class ^= 64;
  1136.         break;
  1137.         case '0': case '1': case '2': case '3': case '4':
  1138.         case '5': case '6': case '7': case '8': case '9':
  1139.         class = scan_oct(--regparse, 3, &numlen);
  1140.         regparse += numlen;
  1141.         break;
  1142.         }
  1143.     }
  1144.     if (range) {
  1145.         if (lastclass > class)
  1146.         FAIL("invalid [] range in regexp");
  1147.         range = 0;
  1148.     }
  1149.     else {
  1150.         lastclass = class;
  1151.         if (*regparse == '-' && regparse+1 < regxend &&
  1152.           regparse[1] != ']') {
  1153.         regparse++;
  1154.         range = 1;
  1155.         continue;    /* do it next time */
  1156.         }
  1157.     }
  1158.     for ( ; lastclass <= class; lastclass++) {
  1159.         regset(bits,def,lastclass);
  1160.         if (regflags & PMf_FOLD && isUPPER(lastclass))
  1161.         regset(bits,def,toLOWER(lastclass));
  1162.     }
  1163.     lastclass = class;
  1164.     }
  1165.     if (*regparse != ']')
  1166.     FAIL("unmatched [] in regexp");
  1167.     nextchar();
  1168.     return ret;
  1169. }
  1170.  
  1171. static char*
  1172. nextchar()
  1173. {
  1174.     char* retval = regparse++;
  1175.  
  1176.     for (;;) {
  1177.     if (*regparse == '(' && regparse[1] == '?' &&
  1178.         regparse[2] == '#') {
  1179.         while (*regparse && *regparse != ')')
  1180.         regparse++;
  1181.         regparse++;
  1182.         continue;
  1183.     }
  1184.     if (regflags & PMf_EXTENDED) {
  1185.         if (isSPACE(*regparse)) {
  1186.         regparse++;
  1187.         continue;
  1188.         }
  1189.         else if (*regparse == '#') {
  1190.         while (*regparse && *regparse != '\n')
  1191.             regparse++;
  1192.         regparse++;
  1193.         continue;
  1194.         }
  1195.     }
  1196.     return retval;
  1197.     }
  1198. }
  1199.  
  1200. /*
  1201. - regnode - emit a node
  1202. */
  1203. #ifdef CAN_PROTOTYPE
  1204. static char *            /* Location. */
  1205. regnode(char op)
  1206. #else
  1207. static char *            /* Location. */
  1208. regnode(op)
  1209. char op;
  1210. #endif
  1211. {
  1212.     register char *ret;
  1213.     register char *ptr;
  1214.  
  1215.     ret = regcode;
  1216.     if (ret == ®dummy) {
  1217. #ifdef REGALIGN
  1218.     if (!(regsize & 1))
  1219.         regsize++;
  1220. #endif
  1221.     regsize += 3;
  1222.     return(ret);
  1223.     }
  1224.  
  1225. #ifdef REGALIGN
  1226. #ifndef lint
  1227.     if (!((long)ret & 1))
  1228.       *ret++ = 127;
  1229. #endif
  1230. #endif
  1231.     ptr = ret;
  1232.     *ptr++ = op;
  1233.     *ptr++ = '\0';        /* Null "next" pointer. */
  1234.     *ptr++ = '\0';
  1235.     regcode = ptr;
  1236.  
  1237.     return(ret);
  1238. }
  1239.  
  1240. /*
  1241. - reganode - emit a node with an argument
  1242. */
  1243. #ifdef CAN_PROTOTYPE
  1244. static char *            /* Location. */
  1245. reganode(char op, unsigned short arg)
  1246. #else
  1247. static char *            /* Location. */
  1248. reganode(op, arg)
  1249. char op;
  1250. unsigned short arg;
  1251. #endif
  1252. {
  1253.     register char *ret;
  1254.     register char *ptr;
  1255.  
  1256.     ret = regcode;
  1257.     if (ret == ®dummy) {
  1258. #ifdef REGALIGN
  1259.     if (!(regsize & 1))
  1260.         regsize++;
  1261. #endif
  1262.     regsize += 5;
  1263.     return(ret);
  1264.     }
  1265.  
  1266. #ifdef REGALIGN
  1267. #ifndef lint
  1268.     if (!((long)ret & 1))
  1269.       *ret++ = 127;
  1270. #endif
  1271. #endif
  1272.     ptr = ret;
  1273.     *ptr++ = op;
  1274.     *ptr++ = '\0';        /* Null "next" pointer. */
  1275.     *ptr++ = '\0';
  1276. #ifdef REGALIGN
  1277.     *(unsigned short *)(ret+3) = arg;
  1278. #else
  1279.     ret[3] = arg >> 8; ret[4] = arg & 0377;
  1280. #endif
  1281.     ptr += 2;
  1282.     regcode = ptr;
  1283.  
  1284.     return(ret);
  1285. }
  1286.  
  1287. /*
  1288. - regc - emit (if appropriate) a byte of code
  1289. */
  1290. #ifdef CAN_PROTOTYPE
  1291. static void
  1292. regc(char b)
  1293. #else
  1294. static void
  1295. regc(b)
  1296. char b;
  1297. #endif
  1298. {
  1299.     if (regcode != ®dummy)
  1300.     *regcode++ = b;
  1301.     else
  1302.     regsize++;
  1303. }
  1304.  
  1305. /*
  1306. - reginsert - insert an operator in front of already-emitted operand
  1307. *
  1308. * Means relocating the operand.
  1309. */
  1310. #ifdef CAN_PROTOTYPE
  1311. static void
  1312. reginsert(char op, char *opnd)
  1313. #else
  1314. static void
  1315. reginsert(op, opnd)
  1316. char op;
  1317. char *opnd;
  1318. #endif
  1319. {
  1320.     register char *src;
  1321.     register char *dst;
  1322.     register char *place;
  1323.     register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
  1324.  
  1325.     if (regcode == ®dummy) {
  1326. #ifdef REGALIGN
  1327.     regsize += 4 + offset;
  1328. #else
  1329.     regsize += 3 + offset;
  1330. #endif
  1331.     return;
  1332.     }
  1333.  
  1334.     src = regcode;
  1335. #ifdef REGALIGN
  1336.     regcode += 4 + offset;
  1337. #else
  1338.     regcode += 3 + offset;
  1339. #endif
  1340.     dst = regcode;
  1341.     while (src > opnd)
  1342.     *--dst = *--src;
  1343.  
  1344.     place = opnd;        /* Op node, where operand used to be. */
  1345.     *place++ = op;
  1346.     *place++ = '\0';
  1347.     *place++ = '\0';
  1348.     while (offset-- > 0)
  1349.     *place++ = '\0';
  1350. #ifdef REGALIGN
  1351.     *place++ = '\177';
  1352. #endif
  1353. }
  1354.  
  1355. /*
  1356. - regtail - set the next-pointer at the end of a node chain
  1357. */
  1358. static void
  1359. regtail(p, val)
  1360. char *p;
  1361. char *val;
  1362. {
  1363.     register char *scan;
  1364.     register char *temp;
  1365.     register I32 offset;
  1366.  
  1367.     if (p == ®dummy)
  1368.     return;
  1369.  
  1370.     /* Find last node. */
  1371.     scan = p;
  1372.     for (;;) {
  1373.     temp = regnext(scan);
  1374.     if (temp == NULL)
  1375.         break;
  1376.     scan = temp;
  1377.     }
  1378.  
  1379. #ifdef REGALIGN
  1380.     offset = val - scan;
  1381. #ifndef lint
  1382.     *(short*)(scan+1) = offset;
  1383. #else
  1384.     offset = offset;
  1385. #endif
  1386. #else
  1387.     if (OP(scan) == BACK)
  1388.     offset = scan - val;
  1389.     else
  1390.     offset = val - scan;
  1391.     *(scan+1) = (offset>>8)&0377;
  1392.     *(scan+2) = offset&0377;
  1393. #endif
  1394. }
  1395.  
  1396. /*
  1397. - regoptail - regtail on operand of first argument; nop if operandless
  1398. */
  1399. static void
  1400. regoptail(p, val)
  1401. char *p;
  1402. char *val;
  1403. {
  1404.     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
  1405.     if (p == NULL || p == ®dummy || regkind[(U8)OP(p)] != BRANCH)
  1406.     return;
  1407.     regtail(NEXTOPER(p), val);
  1408. }
  1409.  
  1410. /*
  1411.  - regcurly - a little FSA that accepts {\d+,?\d*}
  1412.  */
  1413. STATIC I32
  1414. regcurly(s)
  1415. register char *s;
  1416. {
  1417.     if (*s++ != '{')
  1418.     return FALSE;
  1419.     if (!isDIGIT(*s))
  1420.     return FALSE;
  1421.     while (isDIGIT(*s))
  1422.     s++;
  1423.     if (*s == ',')
  1424.     s++;
  1425.     while (isDIGIT(*s))
  1426.     s++;
  1427.     if (*s != '}')
  1428.     return FALSE;
  1429.     return TRUE;
  1430. }
  1431.  
  1432. #ifdef DEBUGGING
  1433.  
  1434. /*
  1435.  - regdump - dump a regexp onto stderr in vaguely comprehensible form
  1436.  */
  1437. void
  1438. regdump(r)
  1439. regexp *r;
  1440. {
  1441.     register char *s;
  1442.     register char op = EXACTLY;    /* Arbitrary non-END op. */
  1443.     register char *next;
  1444.  
  1445.  
  1446.     s = r->program + 1;
  1447.     while (op != END) {    /* While that wasn't END last time... */
  1448. #ifdef REGALIGN
  1449.     if (!((long)s & 1))
  1450.         s++;
  1451. #endif
  1452.     op = OP(s);
  1453.     fprintf(stderr,"%2d%s", s-r->program, regprop(s));    /* Where, what. */
  1454.     next = regnext(s);
  1455.     s += regarglen[(U8)op];
  1456.     if (next == NULL)        /* Next ptr. */
  1457.         fprintf(stderr,"(0)");
  1458.     else 
  1459.         fprintf(stderr,"(%d)", (s-r->program)+(next-s));
  1460.     s += 3;
  1461.     if (op == ANYOF) {
  1462.         s += 32;
  1463.     }
  1464.     if (op == EXACTLY) {
  1465.         /* Literal string, where present. */
  1466.         s++;
  1467.         (void)putc(' ', stderr);
  1468.         (void)putc('<', stderr);
  1469.         while (*s != '\0') {
  1470.         (void)putc(*s, stderr);
  1471.         s++;
  1472.         }
  1473.         (void)putc('>', stderr);
  1474.         s++;
  1475.     }
  1476.     (void)putc('\n', stderr);
  1477.     }
  1478.  
  1479.     /* Header fields of interest. */
  1480.     if (r->regstart)
  1481.     fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
  1482.     if (r->regstclass)
  1483.     fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
  1484.     if (r->reganch & ROPT_ANCH)
  1485.     fprintf(stderr,"anchored ");
  1486.     if (r->reganch & ROPT_SKIP)
  1487.     fprintf(stderr,"plus ");
  1488.     if (r->reganch & ROPT_IMPLICIT)
  1489.     fprintf(stderr,"implicit ");
  1490.     if (r->regmust != NULL)
  1491.     fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
  1492.      (long) r->regback);
  1493.     fprintf(stderr, "minlen %ld ", (long) r->minlen);
  1494.     fprintf(stderr,"\n");
  1495. }
  1496.  
  1497. /*
  1498. - regprop - printable representation of opcode
  1499. */
  1500. char *
  1501. regprop(op)
  1502. char *op;
  1503. {
  1504.     register char *p = 0;
  1505.  
  1506.     (void) strcpy(buf, ":");
  1507.  
  1508.     switch (OP(op)) {
  1509.     case BOL:
  1510.     p = "BOL";
  1511.     break;
  1512.     case MBOL:
  1513.     p = "MBOL";
  1514.     break;
  1515.     case SBOL:
  1516.     p = "SBOL";
  1517.     break;
  1518.     case EOL:
  1519.     p = "EOL";
  1520.     break;
  1521.     case MEOL:
  1522.     p = "MEOL";
  1523.     break;
  1524.     case SEOL:
  1525.     p = "SEOL";
  1526.     break;
  1527.     case ANY:
  1528.     p = "ANY";
  1529.     break;
  1530.     case SANY:
  1531.     p = "SANY";
  1532.     break;
  1533.     case ANYOF:
  1534.     p = "ANYOF";
  1535.     break;
  1536.     case BRANCH:
  1537.     p = "BRANCH";
  1538.     break;
  1539.     case EXACTLY:
  1540.     p = "EXACTLY";
  1541.     break;
  1542.     case NOTHING:
  1543.     p = "NOTHING";
  1544.     break;
  1545.     case BACK:
  1546.     p = "BACK";
  1547.     break;
  1548.     case END:
  1549.     p = "END";
  1550.     break;
  1551.     case ALNUM:
  1552.     p = "ALNUM";
  1553.     break;
  1554.     case NALNUM:
  1555.     p = "NALNUM";
  1556.     break;
  1557.     case BOUND:
  1558.     p = "BOUND";
  1559.     break;
  1560.     case NBOUND:
  1561.     p = "NBOUND";
  1562.     break;
  1563.     case SPACE:
  1564.     p = "SPACE";
  1565.     break;
  1566.     case NSPACE:
  1567.     p = "NSPACE";
  1568.     break;
  1569.     case DIGIT:
  1570.     p = "DIGIT";
  1571.     break;
  1572.     case NDIGIT:
  1573.     p = "NDIGIT";
  1574.     break;
  1575.     case CURLY:
  1576.     (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
  1577.     p = NULL;
  1578.     break;
  1579.     case CURLYX:
  1580.     (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
  1581.     p = NULL;
  1582.     break;
  1583.     case REF:
  1584.     (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
  1585.     p = NULL;
  1586.     break;
  1587.     case OPEN:
  1588.     (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
  1589.     p = NULL;
  1590.     break;
  1591.     case CLOSE:
  1592.     (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
  1593.     p = NULL;
  1594.     break;
  1595.     case STAR:
  1596.     p = "STAR";
  1597.     break;
  1598.     case PLUS:
  1599.     p = "PLUS";
  1600.     break;
  1601.     case MINMOD:
  1602.     p = "MINMOD";
  1603.     break;
  1604.     case GBOL:
  1605.     p = "GBOL";
  1606.     break;
  1607.     case UNLESSM:
  1608.     p = "UNLESSM";
  1609.     break;
  1610.     case IFMATCH:
  1611.     p = "IFMATCH";
  1612.     break;
  1613.     case SUCCEED:
  1614.     p = "SUCCEED";
  1615.     break;
  1616.     case WHILEM:
  1617.     p = "WHILEM";
  1618.     break;
  1619.     default:
  1620.     FAIL("corrupted regexp opcode");
  1621.     }
  1622.     if (p != NULL)
  1623.     (void) strcat(buf, p);
  1624.     return(buf);
  1625. }
  1626. #endif /* DEBUGGING */
  1627.  
  1628. void
  1629. pregfree(r)
  1630. struct regexp *r;
  1631. {
  1632.     if (!r)
  1633.     return;
  1634.     if (r->precomp) {
  1635.     Safefree(r->precomp);
  1636.     r->precomp = Nullch;
  1637.     }
  1638.     if (r->subbase) {
  1639.     Safefree(r->subbase);
  1640.     r->subbase = Nullch;
  1641.     }
  1642.     if (r->regmust) {
  1643.     SvREFCNT_dec(r->regmust);
  1644.     r->regmust = Nullsv;
  1645.     }
  1646.     if (r->regstart) {
  1647.     SvREFCNT_dec(r->regstart);
  1648.     r->regstart = Nullsv;
  1649.     }
  1650.     Safefree(r->startp);
  1651.     Safefree(r->endp);
  1652.     Safefree(r);
  1653. }
  1654.